;; This file is part of scheme-GNUnet.
;; Copyright (C) 2021 GNUnet e.V.
;;
;; scheme-GNUnet is free software: you can redistribute it and/or modify it
;; under the terms of the GNU Affero General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; scheme-GNUnet is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;
;; SPDX-License-Identifier: AGPL-3.0-or-later

;; I'm not sure how to document this.
(define-library (gnu gnunet concurrency repeated-condition)
  (export make-repeated-condition repeated-condition?
	  prepare-await-trigger! await-trigger! trigger-condition!)
  (import (only (rnrs records syntactic)
		define-record-type)
	  (only (guile) pk quote)
	  (only (rnrs base)
		begin lambda define eq? not values)
	  (only (gnu gnunet utils hat-let)
		let^)
	  (prefix (only (fibers conditions)
			make-condition signal-condition! wait-operation)
		  #{cvar:}#)
	  (only (fibers operations)
		choice-operation perform-operation)
	  (only (ice-9 atomic)
		make-atomic-box atomic-box-ref
		atomic-box-compare-and-swap!))
  (begin
    ;; TODO: is this ‘edge-triggered’?  Does this behave like
    ;; POSIX condition variables?
    (define-record-type
	(<repeated-condition> make-repeated-condition repeated-condition?)
      (fields (immutable cvar-box rcvar-cvar-box))
      (protocol
       (lambda (%make)
	 (lambda ()
	   "Make a fresh ‘repeated condition’.

Repeated conditions are a variant of fiber's conditions.
They can be signalled and waited upon like regular conditions.
However, the semantics of waiting multiple times are different.

Each wait creates a ‘waiting event’.  TODO study the literature
for some proper and clear vocabulary."
	   (%make (make-atomic-box (cvar:make-condition)))))))

    ;; Concurrent 'await-trigger!' are not supported!
    ;; Likewise, this procedure should not be interrupted.
    ;; (system-async-mark and fibers scheduling are fine though.)
    ;;
    ;; Each time, a new operation must be made with this procedure.
    ;; Old operations may not be re-used.  The previous operation
    ;; must be performed before creating the next one.
    (define (prepare-await-trigger! rcvar)
      (let^ ((! cvar-box (rcvar-cvar-box rcvar))
	     (! next (cvar:make-condition))
	     (! previous (atomic-box-ref cvar-box))
	     (! operation
		(choice-operation
		 (cvar:wait-operation previous)
		 ;; Include 'next'.  Otherwise, ???.
		 (cvar:wait-operation next)))
	     ;; Tell 'trigger-condition!' about the new
	     ;; condition.
	     (! next-previous
		(atomic-box-compare-and-swap! cvar-box previous next))
	     ;; await-trigger! may not be used concurrently,
	     ;; so this assert should succeed.
	     (!! (eq? previous next-previous)))
	    operation))

    (define (await-trigger! rcvar)
      (perform-operation (prepare-await-trigger! rcvar)))

    (define (trigger-condition! rcvar)
      (let^ ((! cvar-box (rcvar-cvar-box rcvar))
	     (/o/ spin (cvar (atomic-box-ref cvar-box)))
	     (<-- (_) (cvar:signal-condition! cvar))
	     ;; Verify the condition hasn't changed.
	     (! next-old
		(atomic-box-compare-and-swap! cvar-box cvar cvar))
	     ;; If it did change, we notified the wrong condition,
	     ;; so retry!
 	     (? (not next-old) (spin next-old)))
	    (values)))))
